{
open Lexing
open Parser

exception SyntaxError of string

let next_line lexbuf =
  let pos = lexbuf.lex_curr_p in
  lexbuf.lex_curr_p <-
    { pos with
      pos_bol = lexbuf.lex_curr_pos;
      pos_lnum = pos.pos_lnum + 1 }

let lookup_keyword =
  [
    "assign", K_assign;
    "endmodule", K_endmodule;
    "input", K_input;
    "module", K_module;
    "output", K_output;
    "reg", K_reg;
    "wire", K_wire;
  ]
  |> Core.Std.String.Map.of_alist_exn
  |> Core.Std.String.Map.find

}

(* numeric literals *)

let base_prefix = "'" ['s' 'S']?
let dec_base = base_prefix ['d' 'D']
let bin_base = base_prefix ['b' 'B']
(*let oct_base = base_prefix ['o' 'O']*)
let hex_base = base_prefix ['h' 'H']

let bin_digit = ['0' '1']
(*let oct_digit = ['0'-'7']*)
let hex_digit = ['0'-'9' 'a'-'f' 'A'-'F']

let dec_number = ['0'-'9'] ['0'-'9' '_']*
let bin_number = bin_digit (bin_digit|'_')*
(*let oct_number = oct_digit (oct_digit|'_')**)
let hex_number = hex_digit (hex_digit|'_')*

let dec_literal = dec_number? dec_base dec_number
let bin_literal = dec_number? bin_base bin_number
(*let oct_literal = dec_number? oct_base oct_number*)
let hex_literal = dec_number? hex_base hex_number

(* identifiers *)

(* TODO: handle escaped identifiers *)
let ident = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '_' '0'-'9' '$']*

let white = [' ' '\t']+
let comment = "//" [^'\n']* '\n'

rule read = parse
  | white { read lexbuf }
  | comment { next_line lexbuf; read lexbuf }
  | '\n' { next_line lexbuf; read lexbuf }
  | dec_base (dec_number as value)
    { Literal (int_of_string value) }
  | bin_base (bin_number as value)
    { Literal (int_of_string ("0b"^value)) }
  | hex_base (hex_number as value)
    { Literal (int_of_string ("0x"^value)) }
  | ident as s
    { Core.Std.Option.value (lookup_keyword s) ~default:(Ident s) }
  | dec_number as s { Int (int_of_string s) }
  | '&' { Amp }
  | '(' { LParen }
  | ')' { RParen }
  | '+' { Plus }
  | ',' { Comma }
  | '-' { Minus }
  | '.' { Dot }
  | ':' { Colon }
  | ';' { Semi }
  | '=' { Eq }
  | '?' { Quest }
  | '[' { LBrack }
  | ']' { RBrack }
  | '^' { Caret }
  | '{' { LBrace }
  | '|' { Bar }
  | '}' { RBrace }
  | '~' { Tilde }
  | eof { EOF }
